home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _cdc7e0ce8dd2bbb1a7cb7ad1c57bee83 < prev    next >
Encoding:
Text File  |  2002-02-21  |  7.9 KB  |  330 lines
  1. package ActivePerl::DocTools::TOC;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use File::Basename;
  7. use File::Find;
  8. use Config;
  9. use Symbol;
  10.  
  11. # get a default value for $dirbase ... can be overridden? yes, see makefile for details
  12. our $dirbase;
  13. if (exists $Config{installhtmldir}) {
  14.     $dirbase = $Config{installhtmldir};
  15. }
  16. else {
  17.     $dirbase = "$Config{installprefix}/html";
  18. }
  19.  
  20. my @corePodz = qw(
  21. perl perlfaq perltoc perlbook
  22.         __
  23. perlsyn perldata perlop perlsub perlfunc perlreftut perldsc perlrequick perlpod perlstyle perltrap
  24.         __
  25. perlrun perldiag perllexwarn perldebtut perldebug
  26.         __
  27. perlvar perllol perlopentut perlretut
  28.         __
  29. perlre perlref
  30.         __
  31. perlform 
  32.         __
  33. perlboot perltoot perltootc perlobj perlbot perltie
  34.         __
  35. perlipc perlfork perlnumber perlthrtut
  36.         __
  37. perlport  perllocale perlunicode perlebcdic
  38.         __
  39. perlsec
  40.         __
  41. perlmod perlmodlib perlmodinstall perlnewmod
  42.         __
  43. perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 perlfaq6 perlfaq7 perlfaq8 perlfaq9
  44.         __
  45. perlcompile
  46.         __
  47. perlembed perldebguts perlxstut perlxs perlclib perlguts perlcall perlutil perlfilter perldbmfilter perlapi perlintern perlapio perltodo perlhack
  48.         __
  49. perlhist  perldelta perl5005delta perl5004delta
  50.         __
  51. perlaix perlamiga perlbs2000  perlcygwin perldos perlepoc perlhpux perlmachten perlmacos perlmpeix perlos2 perlos390 perlsolaris perlvmesa perlvms perlvos perlwin32 
  52.         );
  53.  
  54.  
  55. # LIST OF METHODS TO OVERRIDE IN YOUR SUBCLASS
  56. {
  57.     no strict "refs";  # trust me, I know what I'm doing
  58.     for my $abstract_method (qw/
  59.     header
  60.     before_pods pod_separator pod after_pods
  61.     before_scripts script after_scripts
  62.     before_pragmas pragma after_pragmas
  63.     before_libraries library library_indent_open library_indent_close library_indent_same library_container after_libraries
  64.     footer/) {
  65.     *$abstract_method = sub { die "The subroutine $abstract_method() must be overriden by the child class!" };
  66.     };
  67. }
  68.  
  69.  
  70. sub new {
  71.     my ($invocant, $options) = @_;
  72.     my $class = ref($invocant) || $invocant;  # object or class name.
  73.     my $self;
  74.  
  75.     if (ref($options) eq 'HASH') {
  76.     $self = $options;
  77.     } else {
  78.     $self = {};
  79.     }
  80.     _BuildHashes($self);
  81.  
  82.     bless ($self, $class);
  83.     return $self;
  84. }
  85.  
  86.  
  87. # generic structure for the website, HTML help, RDF
  88. sub TOC {
  89.     # warn "entered Write";
  90.     my ($self) = @_;
  91.  
  92.     my $verbose = $self->{'verbose'};
  93.  
  94.     my $output;
  95.  
  96.     my %filez = %{$self->{'filez'}};
  97.     my %pragmaz = %{$self->{'pragmaz'}};
  98.     my %podz = %{$self->{'podz'}};
  99.     my %scriptz = %{$self->{'scriptz'}};
  100.  
  101.     # generic header stuff
  102.  
  103.     $output .= $self->boilerplate();
  104.  
  105.     $output .= $self->header();
  106.  
  107.     # core pods
  108.  
  109.     my %unused_podz = %podz;
  110.  
  111.     $output .= $self->before_pods();
  112.  
  113.     foreach my $file (@corePodz) {
  114.     if ($file eq '__') {
  115.         $output .= $self->pod_separator();
  116.     } elsif ($podz{"Pod::$file"}) {
  117.         $output .= $self->pod($file);
  118.         delete $unused_podz{"Pod::$file"};
  119.     } else {
  120.         warn "Couldn't find pod for $file" if $verbose;
  121.     }
  122.     }
  123.  
  124.     foreach my $file (sort keys %unused_podz) {
  125.     warn "Unused Pod: $file" if $verbose;
  126.     }
  127.  
  128.     $output .= $self->after_pods();
  129.  
  130.     $output .= $self->before_scripts();
  131.  
  132.     # scripts
  133.  
  134.     foreach my $file (sort keys %scriptz) {
  135.     $output .= $self->script($file);
  136.     }
  137.  
  138.     $output .= $self->after_scripts();
  139.  
  140.     # pragmas (or pragmata to the pedantic :)
  141.  
  142.     $output .= $self->before_pragmas();
  143.  
  144.     foreach my $file (sort keys %pragmaz) {
  145.     $output .= $self->pragma($file)
  146.     }
  147.  
  148.     $output .= $self->after_pragmas();
  149.  
  150.     # libraries
  151.     $output .= $self->before_libraries();
  152.  
  153.     my $depth=0;
  154.  
  155.     foreach my $file (sort {uc($a) cmp uc($b)} keys %filez) {
  156.  
  157.     my $showfile=$file;
  158.     my $file_depth=0;
  159.     my $depthflag=0;
  160.  
  161.     # cuts $showfile down to its last part, i.e. Foo::Baz::Bar --> Bar
  162.     # and counts the number of times, to get indent. --> 2
  163.     while ($showfile =~ s/.*?::(.*)/$1/) { $file_depth++ }
  164.  
  165.     # if the current file's depth is further out or in than last time,
  166.     # add opening or closing tags.
  167.     while ($file_depth != $depth) {
  168.         if ($file_depth > $depth) {
  169.         $output .= $self->library_indent_open();
  170.         $depth++;
  171.         $depthflag=1;
  172.         }
  173.         elsif ($file_depth < $depth) {
  174.         $output .= $self->library_indent_close();
  175.         $depth--;
  176.         $depthflag=1;
  177.         }
  178.     }
  179.  
  180.     unless ($depthflag) {
  181.         $output .= $self->library_indent_same();
  182.     }
  183.  
  184.     if ($filez{$file}) {
  185.         $output .= $self->library($file, $showfile, $depth);
  186.     } else {
  187.         # assume this is a containing item like a folder or something
  188.         $output .= $self->library_container($file, $showfile, $depth);
  189.     }
  190.     }
  191.  
  192.     $output .= $self->after_libraries();
  193.     $output .= $self->footer();
  194.  
  195.     return $output;
  196. }
  197.  
  198.  
  199. sub _BuildHashes {
  200.  
  201.     my ($self) = shift;
  202.     my $verbose = $self->{'verbose'};
  203.  
  204.     unless (-d $dirbase) {
  205.     die "htmldir not found at: $dirbase";
  206.     }
  207.  
  208.     #warn "entered buildhashes";
  209.  
  210.     my @checkdirs = qw(bin lib site/lib);
  211.  
  212.     my (%filez, %pragmaz, %podz, %scriptz);
  213.  
  214.     my $Process = sub {
  215.     return if -d;
  216.     my $parsefile = $_;
  217.  
  218.     my ($filename,$dir,$suffix) = fileparse($parsefile,'\.html');
  219.  
  220.     if ($suffix !~ m#\.html#) { return; }
  221.  
  222.     my $TOCdir = $dir;
  223.  
  224.     $filename =~ s/(.*)\..*/$1/;
  225.  
  226. #    print "$TOCdir";
  227.     my $ver = $Config{version};
  228.     my $an = $Config{archname};
  229.     if ($TOCdir =~ s#^.*?(bin/)(\Q$an\E/)?(.*)$#$3#) {
  230.         $scriptz{"$TOCdir$filename"} = "bin/$filename.html";
  231.         return 1;
  232.     }
  233.     $TOCdir =~ s#^.*?(lib/site_perl/\Q$ver\E/|lib/\Q$ver\E/|lib/)(\Q$an\E/)?(.*)$#$3#;
  234.     $TOCdir =~ s#/#::#g;
  235.     $TOCdir =~ s#^pod::#Pod::#; #Pod dir is uppercase in Win32
  236. #    print " changed to: $TOCdir\n";
  237.     $dir =~ s#.*?/((site/)?lib.*?)/$#$1#; #looks ugly to get around warning
  238.  
  239.     if ($filez{"$TOCdir/$filename.html"}) {
  240.         warn "$parsefile: REPEATED!\n";
  241.     }
  242.     $filez{"$TOCdir$filename"} = "$dir/$filename.html";
  243. #    print "adding $parsefile as " . $filez{"$TOCdir/$filename.html"} . "\n";
  244. #    print "\%filez{$TOCdir$filename.html}: " . $filez{"$TOCdir$filename.html"} . "\n";
  245.  
  246.     return 1;
  247.     };
  248.  
  249.     foreach my $dir (@checkdirs) {
  250.     find ( { wanted => $Process, no_chdir => 1 }, "$dirbase/$dir")
  251.         if -d "$dirbase/$dir";
  252.     }
  253.  
  254.     foreach my $file (keys %filez) {
  255.     if ($file =~ /^[a-z]/) {  # pragmas in perl are denoted by all lowercase...
  256.         if ($file ne 'perlfilter' and $file ne 'lwpcook') {   # ... except these. sigh. Yes, Dave, it's their fault, but we ought to fix it anyway.
  257.         $pragmaz{$file} = $filez{$file};
  258.         delete $filez{$file};
  259.         }
  260.     } elsif ($file =~ /^Pod::perl/) {
  261.         $podz{$file} = $filez{$file};
  262.         delete $filez{$file};
  263.     } elsif ($file eq 'Pod::PerlEz') {
  264.         #this should be part of ActivePerl dox
  265.         delete $filez{$file};
  266.     }
  267.     }
  268.  
  269.     foreach my $file (sort {uc($b) cmp uc($a)} keys %filez) {
  270.     my $prefix = $file;
  271.     if (! ($prefix =~ s/(.*)?::(.*)/$1/)) {
  272.         warn "$prefix from $file\n" if $verbose;
  273.     } else {
  274.         if (! defined ($filez{$prefix})) {
  275.         $filez{$prefix} = '';
  276.         warn "Added topic: $prefix\n" if $verbose;
  277.         }
  278.         warn " $prefix from $file\n" if $verbose;
  279.     }
  280.     }
  281.  
  282.     $self->{'filez'} = \%filez;
  283.     $self->{'podz'} = \%podz;
  284.     $self->{'pragmaz'} = \%pragmaz;
  285.     $self->{'scriptz'} = \%scriptz;
  286. }
  287.  
  288.  
  289. sub text {
  290.     my ($text) =  join '', map { "$_\n" } @_;
  291.     return sub { $text };
  292. }
  293.  
  294. 1;
  295.  
  296. __END__
  297.  
  298. #=head1 NAME
  299.  
  300. ActivePerl::DocTools::TOC- base class for generating Perl documentation TOC
  301.  
  302. #=head1 SYNOPSIS
  303.  
  304.   use base ('ActivePerl::DocTools::TOC');
  305.  
  306.   # override lots of methods here... see source for which ones
  307.  
  308. #=head1 DESCRIPTION
  309.  
  310. Base class for generating TOC's from Perl html docs.
  311.  
  312. #=head2 EXPORTS
  313.  
  314. $dirbase - where the html files are
  315.  
  316. #=head1 AUTHOR
  317.  
  318. David Sparks, DaveS@ActiveState.com
  319. Neil Kandalgaonkar, NeilK@ActiveState.com
  320.  
  321. #=head1 SEE ALSO
  322.  
  323. The amazing L<PPM>.
  324.  
  325. L<ActivePerl::DocTools::TOC::HTML>
  326.  
  327. L<ActivePerl::DocTools::TOC::RDF>
  328.  
  329. #=cut
  330.